home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / hearts / leafpol9.frm < prev    next >
Text File  |  1999-04-16  |  10KB  |  292 lines
  1. VERSION 5.00
  2. Begin VB.Form LeafPol8 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H80000005&
  5.    BorderStyle     =   0  'None
  6.    Caption         =   "Leafpol8 Prg"
  7.    ClientHeight    =   2400
  8.    ClientLeft      =   1065
  9.    ClientTop       =   1515
  10.    ClientWidth     =   3000
  11.    BeginProperty Font 
  12.       Name            =   "MS Sans Serif"
  13.       Size            =   8.25
  14.       Charset         =   0
  15.       Weight          =   700
  16.       Underline       =   0   'False
  17.       Italic          =   0   'False
  18.       Strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H80000008&
  21.    KeyPreview      =   -1  'True
  22.    LinkTopic       =   "Form1"
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    PaletteMode     =   1  'UseZOrder
  26.    ScaleHeight     =   2400
  27.    ScaleWidth      =   3000
  28.    ShowInTaskbar   =   0   'False
  29.    WindowState     =   2  'Maximized
  30. End
  31. Attribute VB_Name = "LeafPol8"
  32. Attribute VB_GlobalNameSpace = False
  33. Attribute VB_Creatable = False
  34. Attribute VB_PredeclaredId = True
  35. Attribute VB_Exposed = False
  36.      
  37. Private Declare Function ShowCursor& Lib "user32" (ByVal bShow&)    'as Byte
  38. Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  39. Private Sub flower()
  40. pi = 4 * Atn(1)
  41.  f1x = stx: f1y = sty                      'Take TOP of STEM X,Y
  42.   FillColor = QBColor(Int(Rnd * 15) + 1) 'Color of 6 Petals
  43.   a = 8                                           ' Diam of Ring
  44. For s = 3 To 9 Step 3
  45.  For t = 0 To pi Step 0.52              '6 Petals
  46.    d = a * Cos(t)                              'D=Diameter of Ring of Petals
  47.    f2x = d * Cos(t): f2y = d * Sin(t)
  48.    DrawWidth = 1
  49.    Circle (f1x + f2x - 6, f1y + f2y), 9, QBColor(Int(Rnd * 15))
  50.    DrawStyle = 2
  51.    Circle (f1x + f2x - 6, f1y + f2y), 9
  52.    DoEvents
  53.    TimeOut
  54.    DoEvents
  55.  Next t
  56.  DoEvents
  57.   a = a + 9
  58. Next s
  59.  FillStyle = 0                     'For next Screen
  60.  FillColor = QBColor(Int(Rnd * 15))
  61.  Circle (f1x + 8, f1y), 7, QBColor(Int(Rnd * 15))
  62. End Sub
  63.  
  64. Private Sub leafpol8_KeyPress(KeyAscii As Integer)
  65.      ExitClean
  66. End Sub
  67.  
  68. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  69.      ExitClean
  70. End Sub
  71.  
  72. Private Sub Form_Load()
  73. If App.PrevInstance Then
  74.     Unload Me
  75.     Exit Sub
  76. End If
  77. End Sub
  78. Private Sub heart()                   '------        THE   BIG   HEART       ------------
  79. FillColor = QBColor(15)            ' Clear Big Circle
  80. DrawStyle = 0                          'Quick exiting if and when this is made
  81.     Circle (0, 0), 138                  'into a Screen Saver
  82. WaitABit
  83.      pi = 22 / 7
  84.      DrawWidth = 3: DrawStyle = 0
  85.      a = 100: b = 100                                 'Q=Theta Angle  'HEART
  86.      a1 = 102: b1 = 102
  87. For q = -pi / 2 To 0 Step 0.01                  'Polar graph needs Pi iterations.
  88.     Y = a * Cos(q * 2) * Sqr(Abs(Sin(q)))    'here we use part of Polar Spiral
  89.     X = b * Sin(q * 2) * Sqr(Abs(Cos(q)))    'to make half a heart & mirror img.
  90.     Line (0, 0)-(X, Y), QBColor(12)
  91.     DoEvents
  92.     Line (0, 0)-(-X, Y), QBColor(12)
  93.     DoEvents                                            'for Mouse Move exit
  94. Next q
  95.    DoEvents                                              'Posy Start - On Heart
  96.    TimeOut
  97.    DrawStyle = 2: DrawWidth = 1: FillStyle = 0
  98.    FillColor = QBColor(Int(Rnd * 15) + 1)  'Color of 6 Petals
  99.    TimeOut
  100.    TimeOut
  101.    TimeOut
  102.    a = 25                                                           'Diam of Ring of petals.
  103.  For t = 0 To pi Step 0.52 ' pi / 6                      '6 Petals
  104.    d = a * Cos(t)
  105.    X = d * Cos(t): Y = d * Sin(t)
  106.    Circle (X - 12, Y + 32), 12, QBColor(Int(Rnd * 15))
  107.  Next t
  108.  DoEvents
  109.    DrawStyle = 2
  110.    FillColor = QBColor(Int(Rnd * 15))
  111.    Circle (X - 25, Y + 32), 7, QBColor(Int(Rnd * 15)) 'Seed Pod?
  112.  '----------- End of <Flower-in-Heart>
  113. TimeOut
  114. TimeOut
  115. TimeOut
  116. TimeOut
  117. TimeOut
  118.   DoEvents
  119. End Sub
  120. Private Sub leafpol8_Click(Click As Integer)
  121.        ExitClean
  122. End Sub
  123.  
  124.   Private Sub ring()
  125. '========         -- Big Ring
  126. ForeColor = QBColor(12)
  127. pi = 4 * Atn(1)
  128. FillStyle = 0
  129.    ctr = 0: c = 0
  130.    a = 120               'Radius't = -pi
  131.    X = a * Cos(t)      '\ Set
  132.    Y = a * Sin(t)       ' >First
  133.    PSet (X, Y)  '/ Point
  134.    ' --1st Loop  just fills Array.  2nd makes wreath. -------
  135. For t = -pi To pi Step 2 * pi / 32    'Big Pol Circ
  136.     ctr = ctr + 1
  137.     X = a * Cos(t)                      'Convert . .
  138.     Y = a * Sin(t)                       'to Cartesian
  139.     wx(ctr) = X: wy(ctr) = Y       'Fill Wreath Array <wx(),wy()> are SPOTS
  140. Next t                                     ' Spot Centers wx(),wy()
  141.     DoEvents
  142.    '---------------- Make small hearts here---------------@ spots.
  143.     DrawWidth = 3: DrawStyle = 0
  144.     a = 15                                         'Small Hearts
  145. For c = 1 To 32 Step 2
  146.     DoEvents
  147.     DrawWidth = 2
  148.         For q = -pi / 2 To 0 Step 0.05                                '  Small Hearts
  149.             Y = a * Cos(q * 2) * Sqr(Abs(Sin(q)))                  'here we use part of Polar Spiral
  150.             X = a * Sin(q * 2) * Sqr(Abs(Cos(q)))                  'to make half a heart & mirror img.
  151.             Line (wx(c), wy(c))-(X + wx(c), Y + wy(c))   'Small Heart-Right Half
  152.                DoEvents
  153.             Line (wx(c), wy(c))-(-X + wx(c), Y + wy(c))  'Left Half
  154.                DoEvents
  155.         Next q                       'Ring of Small Hearts Done------
  156.         TimeOut
  157.      c = c + 2                       'Next:- Small  FLOWER  Every other "Spot"-
  158.      FillColor = QBColor(Int(Rnd * 15) + 1)      'Color of 6 Petals
  159.         a = 15                                                            ' Diam of petal centers
  160.     DrawStyle = 2
  161.         For t = 0 To pi Step 0.52                                '6 Petals
  162.           d = a * Cos(t)                                                'D=
  163.           fX = d * Cos(t): fY = d * Sin(t)
  164.           DrawWidth = 1
  165.           Circle (fX + wx(c) - 6, fY + wy(c)), 7, QBColor(Int(Rnd * 15))      'Petal
  166.           TimeOut
  167.                  DoEvents
  168.         Next t
  169.         FillStyle = 0
  170.         FillColor = QBColor(Int(Rnd * 15))
  171.         Circle (wx(c), wy(c)), 4, QBColor(Int(Rnd * 15))   'Seed Pod?
  172.         TimeOut
  173.  Next c
  174. '-----------------   Flower every other one.
  175. z = 0: c = 0
  176. DoEvents
  177. Pause
  178. End Sub
  179. '                ---------              Exit on Mouse Move            -----------
  180. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  181. If IsEmpty(mousex) Or IsEmpty(mousey) Or IsNull(mousex) Or IsNull(mousey) Then
  182.         mousex = X:   mousey = Y
  183.         Exit Sub
  184.     End If
  185.    If Abs(mousex - X) > 2 Or Abs(mousey - Y) > 2 Then
  186.             mousex = X:  mousey = Y
  187.            ExitClean
  188.     End If
  189. End Sub
  190.    
  191. Public Sub ExitClean()
  192.  Dim filename As String
  193.     Dim rc As Long
  194.               
  195.     bShow& = ShowCursor(True)          'Via API Function(bShow&) call
  196.         Unload Me                                  'See Declares over Form Code
  197.     End
  198. End Sub
  199.  
  200. Public Sub TimeOut()
  201. t = 0
  202. Interval = 0.025
  203. t = Timer + Interval                            'Seconds
  204.        While Timer < t
  205.        Wend
  206. End Sub
  207.  
  208. Public Sub Pause()
  209. t = 0
  210. t = Timer + 5
  211.     While Timer < t
  212.     DoEvents
  213.     Wend
  214. End Sub
  215.  
  216. Public Sub WaitABit()
  217.  t = 0
  218. t = Timer + 2
  219.     While Timer < t
  220.     DoEvents
  221.     Wend
  222. End Sub
  223.  
  224. Public Sub begin()
  225. bShow& = ShowCursor(False)       'HIDE Mouse via API Function
  226. Randomize                            '========================
  227. Dim pi As Single
  228. pi = 4 * Atn(1)
  229.    a = 20                 'Radius for STEM & LEAVES
  230.    X = a * Cos(t)      ' \ Set
  231.    Y = a * Sin(t)       ' >First
  232.    PSet (X, Y)  '/ Point
  233. Do While DoEvents()
  234. BackColor = QBColor(Int(Rnd * 16))
  235.    ' --1st Loop Round Polar Circ    -     For  RING around Heart
  236. ctr = 0: a = 20
  237. For t = pi To (-pi) - pi / 3 Step -2 * pi / 30   'Big Pol Circ
  238.  ctr = ctr + 1                     'Count Points
  239.    X = a * Cos(t)                'Convert . .
  240.    Y = a * Sin(t)                 'to C